home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / cml-098.lha / cml-0.9.8 / examples / ex-token.sml < prev    next >
Encoding:
Text File  |  1991-06-14  |  1.6 KB  |  59 lines
  1. (* ex-token.sml
  2.  *
  3.  * COPYRIGHT (c) 1990 by John H. Reppy.  See COPYRIGHT file for details.
  4.  *
  5.  * A simple token server.
  6.  *)
  7.  
  8. (* BEGIN EXAMPLE *)
  9. structure TokenServer : TOKEN_SERVER =
  10.   struct
  11.     structure CML = CML
  12.     open CML
  13.  
  14.     datatype ('a, 'b) token = TOKEN of {
  15.     operation : 'a -> 'b,        (* the protected operation *)
  16.     acquire_ch : thread_id chan,    (* the channel for requesting the token *)
  17.     check : unit -> unit,        (* check for token possession *)
  18.     release : unit -> unit        (* release the token *)
  19.       }
  20.  
  21.     exception NotTokenHolder
  22.     fun newToken operFn = let
  23.       val acqCh = channel() and relCh = channel() and holdCh = channel()
  24.       fun server () = let
  25.         val acquireEvt = receive acqCh
  26.         val releaseEvt = receive relCh
  27.         val myId = getTid()
  28.         fun heldLoop curHolder = select [
  29.             wrap (choose [releaseEvt, threadWait curHolder],
  30.               fn () => availLoop ()),
  31.             wrap (transmit(holdCh, curHolder),
  32.               fn () => heldLoop curHolder)
  33.               ]
  34.         and availLoop () = select [
  35.             wrap (acquireEvt, fn id => heldLoop id),
  36.             wrap (transmit(holdCh, myId), fn () => availLoop())
  37.               ]
  38.         in
  39.           availLoop ()
  40.         end
  41.       fun checkFn () = if sameThread(getTid(), accept holdCh)
  42.           then () else raise NotTokenHolder
  43.       in
  44.         spawn server;
  45.         TOKEN{
  46.         operation = fn x => (checkFn(); operFn x),
  47.         acquire_ch = acqCh,
  48.         check = checkFn,
  49.         release = fn () => send(relCh, ())
  50.           }
  51.       end
  52.  
  53.     fun getOperation (TOKEN{check, operation, ...}) = (check(); operation)
  54.     fun releaseToken (TOKEN{check, release, ...}) = (check(); release())
  55.     fun acquireToken (TOKEN{acquire_ch, ...}) = transmit(acquire_ch, getTid())
  56.  
  57.   end (* TokenServer *)
  58. (* END EXAMPLE *)
  59.